unit GLGUIStaticTextArea;

interface

uses
  Classes,
  Types,
  Graphics,
  GLColor,
  GLGraphics,
  GLScene,
  GLCrossPlatform,
  VectorGeometry,
  GLS_Material,
  GLMaterial,
  GLTexture,
  GLState,
  GLRenderContextInfo,
  GLS_Mesh,
  GLS_ShaderParameter,
  GLGUITextComponent,
  GLGUIFonts,
  GLGUIShaders,
  GLGUIQuad,
  GLGUIUtils,
  GLGUITokens;

type
  TGLGUIStaticTextArea = class(TGLGUITextComponent)
  protected
    FBitmap: TGLBitmap;
    FSampler: TGLTextureSampler;
    FNneedTransfer: Boolean;
    procedure SetText(const AText: String); override;
    procedure SetFont(const AFont: TGLGUIBitmapFont); override;
    procedure CreateMaterial;
    procedure TextAreaOnSM3UniformSetting(Sender: TGLBaseShaderModel; var ARci: TRenderContextInfo);
    procedure MultilineCanvasText(Bitmap: TGLBitmap; text: String);
    procedure SetID(AID: Cardinal); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure BuildMesh; override; stdcall;
    procedure DoRender(var ARci: TRenderContextInfo; ARenderSelf,
      ARenderChildren: Boolean); override;
  end;

implementation

uses
  GLGUILayer;

type
  TGLGUIBitmapFontAccessprovider = class(TGLGUIBitmapFont)
  end;
type
  TGLTextureImageExAccessProvider = class(TGLTextureImageEx)
  end;

constructor TGLGUIStaticTextArea.Create(AOwner: TComponent);
begin
  FBitmap := TGLBitmap.Create;
  FTexture := GetInternalMaterialLibrary.AddTexture('TextArea');
  inherited;
  CreateMaterial;
  Text := 'TGLGUIStaticTextArea';
end;

procedure TGLGUIStaticTextArea.SetID(AID: Cardinal);
begin
  FID := AID;
  FBatch.Mesh.TagInteger := FID;
end;

procedure TGLGUIStaticTextArea.CreateMaterial;
const
  cDefaultTextureSamplerName = 'TextAreaSampler';
begin
  with GetInternalMaterialLibrary do
  begin
    FSampler := Components.GetSamplerByName(cDefaultTextureSamplerName);
    if not Assigned(FSampler) then
      FSampler := AddSampler(cDefaultTextureSamplerName);
  end;
  FSampler.MagFilter := maNearest;
  FSampler.MinFilter := miLinear;

  FBatch.Material := GetInternalMaterialLibrary.Materials.GetLibMaterialByName('TGLGUIQuad_Material');
  if FBatch.Material = nil then
  begin
    FBatch.Material := GetInternalMaterialLibrary.Materials.Add;
    with TGLLibMaterialEx(FBatch.Material) do
    begin
      Name := 'TGLGUIQuad_Material';
      FixedFunction.BlendingMode := bmTransparency;
      FixedFunction.MaterialOptions := [moNoLighting];
      FixedFunction.Texture.Enabled := True;
      FixedFunction.Texture.EnvMode := tmModulate;
      FixedFunction.FrontProperties.Diffuse.Color := FColor.Color;
      FixedFunction.Texture.LibTextureName := FTexture.Name;
      FixedFunction.Texture.LibSamplerName := FSampler.Name;

      ShaderModel3.LibVertexShaderName := QuadShader.Vertex;
      ShaderModel3.LibFragmentShaderName := QuadShader.Fragment;
      ShaderModel3.Enabled := True;
      OnSM3UniformSetting := TextAreaOnSM3UniformSetting;

      ApplicableLevel := mlFixedFunction;
    end;
  end;
  FBatch.Changed := True;
end;

procedure TGLGUIStaticTextArea.TextAreaOnSM3UniformSetting(Sender: TGLBaseShaderModel; var ARci: TRenderContextInfo);
var
  vArea: TGLGUIStaticTextArea;
begin
  with TGLGUILayer(FLayer) do
    vArea := TGLGUIStaticTextArea(GUIObjects[TMeshAtom(Arci.mesh).TagInteger]);
  if Sender.IsValid then
  begin
    Sender.Uniforms['TexUnit0'].TextureName := vArea.FTexture.Name;
    Sender.Uniforms['TexUnit0'].SamplerName := FSampler.Name;
    Sender.Uniforms['uModulateColor'].vec4 := vArea.FColor.Color;
    Sender.Uniforms['Alpha'].float := vArea.Alpha;
    Sender.Uniforms['uAdditiveColor'].vec4 := vArea.FFillColor.Color;
    Sender.Uniforms['TransformationsMatrix'].mat4 := vArea.GetAbsoluteMatrix;
  end;
end;

procedure TGLGUIStaticTextArea.BuildMesh;
begin
  with FBatch.Mesh do
  begin
    Lock;
    try
      Clear;
      DeclareAttribute(attrPosition, GLSLType3f);
      DeclareAttribute(attrTexCoord0, GLSLType2f);
      BeginAssembly(mpTRIANGLE_STRIP);
      Attribute2f(attrTexCoord0, 0, 1);
      Attribute3f(attrPosition, -0.5, 0.5, 0);
      EmitVertex;
      Attribute2f(attrTexCoord0, 0, 0);
      Attribute3f(attrPosition, -0.5, -0.5, 0);
      EmitVertex;
      Attribute2f(attrTexCoord0, 1, 1);
      Attribute3f(attrPosition, 0.5, 0.5, 0);
      EmitVertex;
      Attribute2f(attrTexCoord0, 1, 0);
      Attribute3f(attrPosition, 0.5, -0.5, 0);
      EmitVertex;
      EndAssembly;
    finally
      UnLock;
    end;
  end;
  FBatch.Changed := True;
  ClearStructureChanged;
end;

procedure TGLGUIStaticTextArea.DoRender(var ARci: TRenderContextInfo; ARenderSelf, ARenderChildren: Boolean);
  procedure PrepareSelf;
  begin
    if ocStructure in Changes then
    begin
{$IFDEF GLS_SERVICE_CONTEXT}
      if not (osStreamDraw in ObjectStyle) and IsServiceContextAvaible then
      begin
        if not Assigned(FFinishEvent) then
        begin
          FFinishEvent := TFinishTaskEvent.Create;
          AddTaskForServiceContext(BuildMesh, FFinishEvent);
        end
        else if FFinishEvent.WaitFor(0) = wrSignaled then
        begin
          FFinishEvent.ResetEvent;
          AddTaskForServiceContext(BuildMesh, FFinishEvent);
        end;
        exit;
      end
      else
{$ENDIF GLS_SERVICE_CONTEXT}
        BuildMesh;
    end;
    if ARenderSelf then
    begin
      ARci.PipelineTransformation.Push;
      ARci.PipelineTransformation.ModelMatrix := IdentityHmgMatrix;
      ARci.PipelineTransformation.ViewMatrix := IdentityHmgMatrix;
      ARci.PipelineTransformation.ProjectionMatrix := GetAbsoluteMatrix;
      FTransformation := ARci.PipelineTransformation.StackTop;
      ARci.PipelineTransformation.Pop;

      FBatch.Order := ARci.orderCounter;
    end;
  end;
begin
  with TGLLibMaterialEx(FBatch.Material) do
    FixedFunction.FrontProperties.Diffuse.Color := FColor.Color;
  PrepareSelf;
  if FNneedTransfer then
  begin
    FNneedTransfer := False;
    TGLTextureImageExAccessProvider(FTexture).FullTransfer;
  end;
  if ARenderChildren then
    RenderChildren(0, Count - 1, ARci);
end;

procedure TGLGUIStaticTextArea.SetFont(const AFont: TGLGUIBitmapFont);
begin
  if (AFont <> FFont)  then
  begin
    if ASsigned(FFont) then
      FFont.UnRegisterUser(Self);
    FFont := AFont;
    FFont.RegisterUser(Self);
    Text := FText;
  end;
  DispatchEvent('FontUpdated');
end;

procedure TGLGUIStaticTextArea.MultilineCanvasText(Bitmap: TGLBitmap; text: String);
var
  textSize: TSize;
  lines: TStringList;
  i, blockHeight: Integer;
  vMaxWidth: integer;
  vBitmapRectangle: PRect;
begin
  Bitmap.Canvas.Font := TGLGUIBitmapFontAccessprovider(Font).FFont;

  lines := TStringList.Create;
  lines.Text := text;
  textSize := Bitmap.canvas.TextExtent('LOZL!');
  blockHeight := textSize.cy * lines.Count;
  blockHeight := blockHeight;
  vMaxWidth := 0;

  for i := 0 to lines.Count - 1 do
  begin
    textSize := Bitmap.Canvas.TextExtent(lines[i]);
    vMaxWidth := MaxInteger(textSize.cx, vMaxWidth);
  end;

  with Bitmap do
  begin
    PixelFormat := GLPF24bit;
    Width := vMaxWidth;
    Height := blockHeight;
    New(vBitmapRectangle);
    vBitmapRectangle^.Left := 0;
    vBitmapRectangle^.Top := 0;
    vBitmapRectangle^.Right := vMaxWidth;
    vBitmapRectangle^.Bottom := blockHeight;
    Canvas.Brush.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(vBitmapRectangle^);
    Dispose(vBitmapRectangle);
  end;

  for i := 0 to lines.Count - 1 do
  begin
    textSize := Bitmap.canvas.TextExtent(lines[i]);
    Bitmap.canvas.TextOut(0, (textSize.cy * i), lines[i]);
  end;
end;

procedure TGLGUIStaticTextArea.SetText(const AText: String);
begin
  MultilineCanvasText(FBitmap, FText);

  Width := FBitmap.Width;
  Height := FBitmap.Height;

  with TGLTextureImageExAccessProvider(FTexture) do
  begin
    if not Assigned(FImage) then
      FImage := TGLImage.Create;
    TGLImage(FImage).Assign(FBitmap);
    TGLImage(FImage).Narrow;
    with TGLImage(FImage) do
    begin
      if (Width>0) and (Height>0) then
        SetAlphaTransparentForColor(Data[Width * (Height - 1)]);
    end;
  end;

  FText := AText;

  FNneedTransfer := True;
end;

end.
